Today we are going to talk about running some basic statistics in R.

library(tidyverse)
Registered S3 method overwritten by 'dplyr':
  method           from
  print.rowwise_df     
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
✓ ggplot2 3.2.1     ✓ purrr   0.3.3
✓ tibble  2.1.3     ✓ dplyr   0.8.3
✓ tidyr   1.0.2     ✓ stringr 1.4.0
✓ readr   1.3.1     ✓ forcats 0.4.0
── Conflicts ─────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
library(plotly)
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 methods overwritten by 'htmltools':
  method               from         
  print.html           tools:rstudio
  print.shiny.tag      tools:rstudio
  print.shiny.tag.list tools:rstudio
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
library(cowplot)

********************************************************
Note: As of version 1.0.0, cowplot does not change the
  default ggplot2 theme anymore. To recover the previous
  behavior, execute:
  theme_set(theme_cowplot())
********************************************************

Usually, when I want to run stats on a thing, I start with some basic descriptive stats. Fortunately we did this last week with the starwars dataset, so lets jump back in.

data(starwars)

Lots of statistics are applied to continuous variables. Lets take a look at the relationship between height and mass. I’m going to make an interactive plot with ggplotly so we can mouse over points and see them better.

Here I included a name and spec variable, but didn’t map them to anything. Thats so you can see them when you mouse over them.

hmPlot <- starwars %>% ggplot(aes(x = height, y = mass, name = name, spec = species)) + geom_point() + theme_cowplot()
ggplotly(hmPlot)

Woah dude. One character is anomalously heavy. Mouse over the outlier so you can see who it is.

That was my first guess too

That was my first guess too

Jabba is probably going to screw up all of our stats, lets focus on the relationship of all of the other charactersby removing him.

starwars01 <- starwars %>% filter(!str_detect(name, "Jabba")) # Complecated syntac because I can't spell the rest of his name
hmPlot01 <- starwars01 %>% ggplot(aes(x = height, y = mass, name = name, spec = species)) + geom_point() + theme_cowplot()
ggplotly(hmPlot01)

So here’s our relationship. It looks sort of, but not reeally linear, which makes sense, there are lots of species in the galaxy.

Sometimes when we do stats, the stats like to imagine normally distributed data.

starwars01 %>% pivot_longer(cols = mass:height, names_to = "measurement", values_to = "value") %>% 
  ggplot(aes(x = value)) + facet_wrap(measurement~.) + geom_histogram()

Hmm. Sort of.

See if you can figure out what I did above.

Lets see if height and width are correlated.

cor.test(starwars01$height, starwars01$mass, method = "pearson")

    Pearson's product-moment correlation

data:  starwars01$height and starwars01$mass
t = 8.7853, df = 56, p-value = 4.018e-12
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.6260700 0.8520232
sample estimates:
      cor 
0.7612612 
cor.test(starwars01$height, starwars01$mass, method = "spearman")
Cannot compute exact p-value with ties

    Spearman's rank correlation rho

data:  starwars01$height and starwars01$mass
S = 6946.8, p-value = 2.597e-13
alternative hypothesis: true rho is not equal to 0
sample estimates:
     rho 
0.786313 

Here are a parametric and non-parametric correlation test. The values I usually think about are cor (pearson), which is the R value, or rho(spearman) which is its “rho” which is a lot like an R value.

Numbers closer to 1 are more positively correlated, closer to -1 are more negatively correlated, closer to 0 are not correlated.

There is a p-value for both of these, which is essentially the probability that if all of the assumptions of the model hold, the true R or rho value is zero.

Regressions

Regressions are also pretty popular with the kids these days. Lets do one! Lets see how well height explains mass

mod <- lm(mass ~ height, data = starwars01)
summary(mod)

Call:
lm(formula = mass ~ height, data = starwars01)

Residuals:
    Min      1Q  Median      3Q     Max 
-39.382  -8.212   0.211   3.846  57.327 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) -32.54076   12.56053  -2.591   0.0122 *  
height        0.62136    0.07073   8.785 4.02e-12 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 19.14 on 56 degrees of freedom
  (28 observations deleted due to missingness)
Multiple R-squared:  0.5795,    Adjusted R-squared:  0.572 
F-statistic: 77.18 on 1 and 56 DF,  p-value: 4.018e-12

Lets look at what this tells us. Residuals are essentially the distance of each point from the models prediction. The one that is farthest below is ~ -39 too low, the highest above is ~ 57 and the median and first and third quartiles are also shown.

Coefficients are often what you care about. The estemate tells us about the slope and intercept of the linear regression. These values basically say our model looks like this

mass = -32.5 + 0.62 * height

We don’t know the true values of these paramters, so the standard error gives us an idea of the ranges of the two. T-value is the test score to see how good those are, band the p-value tells you if the answer is statistically significant.

4.02 x 10^-12 < 0.002 so it the height value gets a bunch of stars after it. I usually don’t make too much of the p value of the intercept.

Residual standard error is the standard deviation of the residuals, according to the internet. 56 degrees of freedom is calculated as our sample size, minus the complexity of the model. We have 58 characters, but we loose one DF for the intercept and another for the height varaible that we are using.

There is also an R^2, and adjusted R^2 which gets smaller as the model gets more complicated, and a p-value for the whole model.

Residuals

Linear models like to assume that the residuals are normally distributed. We want to make sure that no person is really affecting our model too much. We can plot the model to do this.

plot(mod)

Processing models

the broom package gives a nice matrix version of model results

library(broom)
tidy(mod)

Lets see how well our model’s predictions compare to the actual data.

We can use the predict function to generate some predictions

# Make a data frame containing all of the possible heights, from the shortist to tallest character
predPreDf <- tibble(
  height = min(na.omit(starwars01$height)): max(na.omit(starwars01$height))
)

# for each height, predict the mass
PredMass <- predict(mod, predPreDf) # predict requires a model, mod, and a data frame with the predictors in it. Our only predictor is height, so its just a data frame with one thing

# Stick the range of heights and predicted masses together into a data fraeme
predDf <- tibble(height = predPreDf$height, mass = PredMass)

# plot the original data
starwars01 %>% ggplot(aes(x = height, y = mass)) + geom_point() +
  # plot the predicted values, notice that I include the predicted data in the "data" argument below
  geom_path(aes(x = height, y = mass), data = predDf, color = "darkgreen")

Models with categorical variables

There are a lot of species right now, but most of them only have a few characters. I’m interested in looking at things that differentiate humans from other species. So lets make a new column that indicates whether a character is human

starwars02 <- starwars01 %>% mutate(isHuman = ifelse(species == "Human", "Yes", "No"))

Lets see if humanity is a reasonable predictor of a characters’ mass.

First, lets plot the two against eachother

ggplot(aes(mass, isHuman), data = starwars02) + geom_point()

ok, one person has a species that is NA. It looks like humans tend to be intermediate in mass, with a lot of overlap of the non humans.

Lets ask if humans tend to have different mass than non humans. I’m betting not so much, since they seem to be right in the middle of the other organisms masses.

modMH <- lm(mass ~ isHuman, data = starwars02)
summary(modMH)

Call:
lm(formula = mass ~ isHuman, data = starwars02)

Residuals:
    Min      1Q  Median      3Q     Max 
-56.834 -15.634  -3.782  10.166  87.166 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   71.834      4.909  14.634   <2e-16 ***
isHumanYes    10.948      7.901   1.386    0.171    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 29.04 on 55 degrees of freedom
  (29 observations deleted due to missingness)
Multiple R-squared:  0.03373,   Adjusted R-squared:  0.01616 
F-statistic:  1.92 on 1 and 55 DF,  p-value: 0.1715

So with categorical variables, we can interperet this much the same way as in the last plot. We have a model that looks something like.

mass = 72 + 11 * isHumanYes

This essentially says that it the character was not human, we treat isHumanYes as 0, and if the character is human, we treat it as one. This says essentially that the average mass of a human is.

72 + 11 * 1 = 83

And for non humans 71 + 11 * 0 = 72.

That said, our p value for the isHumanYes term is 0.171, which is > 0.05, which means that even if there was no real trend, its pretty likely that we could have gotten at least this strong of a result.

We can make our model even more complicated by adding in gender.

plotHumanSpec <- ggplot(aes(mass, isHuman, shape = gender, name = name, species = species), data = starwars02) + geom_point(size = 2) 

ggplotly(plotHumanSpec)

Among other things, it becomes clear that most characters in starwars are males.

starwars02 %>% group_by(isHuman, gender) %>% summarize(n = n())

One character has no gender and a few have NA for gender. And in the star wars universe, that is the limit to characters gender types. We won’t have the statistical power to look at more than male and female characters here, and so I’m going to limit the analysis just to just male, female, human, and nonhuman.

starwars03 <- starwars02 %>% filter(gender %in% c("male", "female"), isHuman %in% c("Yes", "No"))
modMHG <- lm(mass ~ isHuman + gender, data = starwars03)
summary(modMHG)

Call:
lm(formula = mass ~ isHuman + gender, data = starwars03)

Residuals:
    Min      1Q  Median      3Q     Max 
-62.021  -9.246  -1.614   5.386  81.979 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   51.614      8.993   5.739 5.55e-07 ***
isHumanYes     9.226      7.264   1.270   0.2099    
gendermale    25.407      9.532   2.665   0.0103 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 25.98 on 50 degrees of freedom
  (23 observations deleted due to missingness)
Multiple R-squared:  0.1565,    Adjusted R-squared:  0.1228 
F-statistic: 4.639 on 2 and 50 DF,  p-value: 0.01419

So here we try a model with both isHuman and male. You would interpret this the same way. So a human female would have a predicted mass of.

mass = 52 + (9 * 1) + (25 * 0)

Our p value is above 0.05 for isHumanYes again though, so that variable doesn’t seem to be a statistically significant predictor.

Interaction terms

Lets add an interaction term

modMHG2 <- lm(mass ~ gender * height , data = starwars03)
summary(modMHG2)

Call:
lm(formula = mass ~ gender * height, data = starwars03)

Residuals:
    Min      1Q  Median      3Q     Max 
-42.042  -6.435  -1.431   0.933  55.141 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)
(Intercept)        47.37255  100.63238   0.471    0.640
gendermale        -73.26685  101.40535  -0.723    0.473
height              0.04321    0.59338   0.073    0.942
gendermale:height   0.55750    0.59735   0.933    0.355

Residual standard error: 16.68 on 49 degrees of freedom
  (23 observations deleted due to missingness)
Multiple R-squared:  0.6594,    Adjusted R-squared:  0.6386 
F-statistic: 31.62 on 3 and 49 DF,  p-value: 1.612e-11

So here, we predict with a continuous variable (height) a discrete variable (gender = male, 1 if yes, 0 if no) and the interaction between th two. In any case this isn’t a useful model, based on the p value for each of the terms. That said, the model wide p-value 1.61e-11 is really low. I’m not quite sure hot to interperet that. The model as a whole works, but no specific variable is a good predictor?

Logistic models

What if we have a binary variable as our y value, rather than as our x value. Then we want to use logistic regression.

starwars04 <- starwars03 %>% mutate(isHumanNum = ifelse(isHuman == "Yes", 1, 0))
modBinom <- glm(isHumanNum ~ mass, family = binomial, data = starwars04)
summary(modBinom)

Call:
glm(formula = isHumanNum ~ mass, family = binomial, data = starwars04)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.5577  -1.0515  -0.8546   1.3087   1.5391  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)  
(Intercept) -1.48217    0.89174  -1.662   0.0965 .
mass         0.01473    0.01085   1.358   0.1744  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 71.938  on 52  degrees of freedom
Residual deviance: 69.959  on 51  degrees of freedom
  (23 observations deleted due to missingness)
AIC: 73.959

Number of Fisher Scoring iterations: 4

So in the above example, we are predicting the probability of being male from the data. Its not a statistically significant model, but lets plot the probability of being human from mass

massRange <- min(na.omit(starwars04$mass)):max(na.omit(starwars04$mass))

humanPred <- predict(modBinom, newdata = tibble(mass = massRange), type = "response") # for glm its called newdata, not data

predDfMG <- tibble(mass = massRange, isHumanNum = humanPred)
predDfMG

ggplot(aes(x = mass, y = isHumanNum), data = starwars04) + geom_point() + 
  geom_path(data = predDfMG)

So here, the line indicates the probability, based on our model, that a character is human, based on their mass.

I notice though that humans tend to have intermediate mass. Lets use a polynomial regression to address this. To do this, I include a squared term in the model.

modBinom2 <- glm(isHumanNum ~ mass + I(mass^2), family = binomial, data = starwars04)
summary(modBinom2)

Call:
glm(formula = isHumanNum ~ mass + I(mass^2), family = binomial, 
    data = starwars04)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.3249  -1.1479  -0.4838   1.1410   1.9263  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)  
(Intercept) -6.5908502  3.0668834  -2.149   0.0316 *
mass         0.1414293  0.0692430   2.043   0.0411 *
I(mass^2)   -0.0007204  0.0003791  -1.900   0.0574 .
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 71.938  on 52  degrees of freedom
Residual deviance: 64.331  on 50  degrees of freedom
  (23 observations deleted due to missingness)
AIC: 70.331

Number of Fisher Scoring iterations: 5

Hey, This looks ok!

Lets plot it!

massRange <- min(na.omit(starwars04$mass)):max(na.omit(starwars04$mass))

humanPred <- predict(modBinom2, newdata = tibble(mass = massRange), type = "response") # for glm its called newdata, not data

predDfMG <- tibble(mass = massRange, isHumanNum = humanPred)
predDfMG

ggplot(aes(x = mass, y = isHumanNum), data = starwars04) + geom_point() + 
  geom_path(data = predDfMG)

This actually makes ok sense. At intermediate masses, things are around 50% likely to be human. At large and small masses, they are a lot less likely to be human.

LS0tCnRpdGxlOiAiQmlvVkNOIFIgTGVzc29uIDA3IC0tIFN0YXRpc3RpY3MiCmF1dGhvcjogIkphY29iIEEuIENyYW0iCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClRvZGF5IHdlIGFyZSBnb2luZyB0byB0YWxrIGFib3V0IHJ1bm5pbmcgc29tZSBiYXNpYyBzdGF0aXN0aWNzIGluIFIuCgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkocGxvdGx5KQpsaWJyYXJ5KGNvd3Bsb3QpCmBgYAoKVXN1YWxseSwgd2hlbiBJIHdhbnQgdG8gcnVuIHN0YXRzIG9uIGEgdGhpbmcsIEkgc3RhcnQgd2l0aCBzb21lIGJhc2ljIGRlc2NyaXB0aXZlIHN0YXRzLiBGb3J0dW5hdGVseSB3ZSBkaWQgdGhpcyBsYXN0IHdlZWsgd2l0aCB0aGUgc3RhcndhcnMgZGF0YXNldCwgc28gbGV0cyBqdW1wIGJhY2sgaW4uCgpgYGB7cn0KZGF0YShzdGFyd2FycykKYGBgCgpMb3RzIG9mIHN0YXRpc3RpY3MgYXJlIGFwcGxpZWQgdG8gY29udGludW91cyB2YXJpYWJsZXMuIExldHMgdGFrZSBhIGxvb2sgYXQgdGhlIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIGhlaWdodCBhbmQgbWFzcy4KSSdtIGdvaW5nIHRvIG1ha2UgYW4gaW50ZXJhY3RpdmUgcGxvdCB3aXRoIGBnZ3Bsb3RseWAgc28gd2UgY2FuIG1vdXNlIG92ZXIgcG9pbnRzIGFuZCBzZWUgdGhlbSBiZXR0ZXIuCgpIZXJlIEkgaW5jbHVkZWQgYSBuYW1lIGFuZCBzcGVjIHZhcmlhYmxlLCBidXQgZGlkbid0IG1hcCB0aGVtIHRvIGFueXRoaW5nLiBUaGF0cyBzbyB5b3UgY2FuIHNlZSB0aGVtIHdoZW4geW91IG1vdXNlIG92ZXIgdGhlbS4KYGBge3J9CmhtUGxvdCA8LSBzdGFyd2FycyAlPiUgZ2dwbG90KGFlcyh4ID0gaGVpZ2h0LCB5ID0gbWFzcywgbmFtZSA9IG5hbWUsIHNwZWMgPSBzcGVjaWVzKSkgKyBnZW9tX3BvaW50KCkgKyB0aGVtZV9jb3dwbG90KCkKZ2dwbG90bHkoaG1QbG90KQpgYGAKCldvYWggZHVkZS4gT25lIGNoYXJhY3RlciBpcyBhbm9tYWxvdXNseSBoZWF2eS4gCk1vdXNlIG92ZXIgdGhlIG91dGxpZXIgc28geW91IGNhbiBzZWUgd2hvIGl0IGlzLgoKCiFbVGhhdCB3YXMgbXkgZmlyc3QgZ3Vlc3MgdG9vXShwaWNzLzQ5OHB4LUphYmJhX3RoZV9IdXR0LmpwZykKCkphYmJhIGlzIHByb2JhYmx5IGdvaW5nIHRvIHNjcmV3IHVwIGFsbCBvZiBvdXIgc3RhdHMsIGxldHMgZm9jdXMgb24gdGhlIHJlbGF0aW9uc2hpcCBvZiBhbGwgb2YgdGhlIG90aGVyIGNoYXJhY3RlcnNieSByZW1vdmluZyBoaW0uCgpgYGB7cn0Kc3RhcndhcnMwMSA8LSBzdGFyd2FycyAlPiUgZmlsdGVyKCFzdHJfZGV0ZWN0KG5hbWUsICJKYWJiYSIpKSAjIENvbXBsZWNhdGVkIHN5bnRhYyBiZWNhdXNlIEkgY2FuJ3Qgc3BlbGwgdGhlIHJlc3Qgb2YgaGlzIG5hbWUKYGBgCgpgYGB7cn0KaG1QbG90MDEgPC0gc3RhcndhcnMwMSAlPiUgZ2dwbG90KGFlcyh4ID0gaGVpZ2h0LCB5ID0gbWFzcywgbmFtZSA9IG5hbWUsIHNwZWMgPSBzcGVjaWVzKSkgKyBnZW9tX3BvaW50KCkgKyB0aGVtZV9jb3dwbG90KCkKZ2dwbG90bHkoaG1QbG90MDEpCmBgYAoKU28gaGVyZSdzIG91ciByZWxhdGlvbnNoaXAuIEl0IGxvb2tzIHNvcnQgb2YsIGJ1dCBub3QgcmVlYWxseSBsaW5lYXIsIHdoaWNoIG1ha2VzIHNlbnNlLCB0aGVyZSBhcmUgbG90cyBvZiBzcGVjaWVzIGluIHRoZSBnYWxheHkuCgpTb21ldGltZXMgd2hlbiB3ZSBkbyBzdGF0cywgdGhlIHN0YXRzIGxpa2UgdG8gaW1hZ2luZSBub3JtYWxseSBkaXN0cmlidXRlZCBkYXRhLgoKYGBge3J9CnN0YXJ3YXJzMDEgJT4lIHBpdm90X2xvbmdlcihjb2xzID0gbWFzczpoZWlnaHQsIG5hbWVzX3RvID0gIm1lYXN1cmVtZW50IiwgdmFsdWVzX3RvID0gInZhbHVlIikgJT4lIAogIGdncGxvdChhZXMoeCA9IHZhbHVlKSkgKyBmYWNldF93cmFwKG1lYXN1cmVtZW50fi4pICsgZ2VvbV9oaXN0b2dyYW0oKQpgYGAKCkhtbS4gU29ydCBvZi4KClNlZSBpZiB5b3UgY2FuIGZpZ3VyZSBvdXQgd2hhdCBJIGRpZCBhYm92ZS4gCgpMZXRzIHNlZSBpZiBoZWlnaHQgYW5kIHdpZHRoIGFyZSBjb3JyZWxhdGVkLgoKYGBge3J9CmNvci50ZXN0KHN0YXJ3YXJzMDEkaGVpZ2h0LCBzdGFyd2FyczAxJG1hc3MsIG1ldGhvZCA9ICJwZWFyc29uIikKY29yLnRlc3Qoc3RhcndhcnMwMSRoZWlnaHQsIHN0YXJ3YXJzMDEkbWFzcywgbWV0aG9kID0gInNwZWFybWFuIikKYGBgCgpIZXJlIGFyZSBhIHBhcmFtZXRyaWMgYW5kIG5vbi1wYXJhbWV0cmljIGNvcnJlbGF0aW9uIHRlc3QuIFRoZSB2YWx1ZXMgSSB1c3VhbGx5IHRoaW5rIGFib3V0IGFyZSBjb3IgKHBlYXJzb24pLCB3aGljaCBpcyB0aGUgUiB2YWx1ZSwgb3IgcmhvKHNwZWFybWFuKSB3aGljaCBpcyBpdHMgInJobyIgd2hpY2ggaXMgYSBsb3QgbGlrZSBhbiBSIHZhbHVlLgoKTnVtYmVycyBjbG9zZXIgdG8gMSBhcmUgbW9yZSAgcG9zaXRpdmVseSBjb3JyZWxhdGVkLCBjbG9zZXIgdG8gLTEgYXJlIG1vcmUgIG5lZ2F0aXZlbHkgY29ycmVsYXRlZCwgY2xvc2VyIHRvIDAgYXJlIG5vdCBjb3JyZWxhdGVkLiAKClRoZXJlIGlzIGEgcC12YWx1ZSBmb3IgYm90aCBvZiB0aGVzZSwgd2hpY2ggaXMgZXNzZW50aWFsbHkgdGhlIHByb2JhYmlsaXR5IHRoYXQgaWYgYWxsIG9mIHRoZSBhc3N1bXB0aW9ucyBvZiB0aGUgbW9kZWwgaG9sZCwgdGhlIHRydWUgUiBvciByaG8gdmFsdWUgaXMgemVyby4KCiMgUmVncmVzc2lvbnMKUmVncmVzc2lvbnMgYXJlIGFsc28gcHJldHR5IHBvcHVsYXIgd2l0aCB0aGUga2lkcyB0aGVzZSBkYXlzLiBMZXRzIGRvIG9uZSEKTGV0cyBzZWUgaG93IHdlbGwgYGhlaWdodGAgZXhwbGFpbnMgYG1hc3NgCgpgYGB7cn0KbW9kIDwtIGxtKG1hc3MgfiBoZWlnaHQsIGRhdGEgPSBzdGFyd2FyczAxKQpzdW1tYXJ5KG1vZCkKYGBgCgpMZXRzIGxvb2sgYXQgd2hhdCB0aGlzIHRlbGxzIHVzLgpSZXNpZHVhbHMgYXJlIGVzc2VudGlhbGx5IHRoZSBkaXN0YW5jZSBvZiBlYWNoIHBvaW50IGZyb20gdGhlIG1vZGVscyBwcmVkaWN0aW9uLiBUaGUgb25lIHRoYXQgaXMgZmFydGhlc3QgYmVsb3cgaXMgfiAtMzkgdG9vIGxvdywgdGhlIGhpZ2hlc3QgYWJvdmUgaXMgfiA1NyBhbmQgdGhlIG1lZGlhbiBhbmQgZmlyc3QgYW5kIHRoaXJkIHF1YXJ0aWxlcyBhcmUgYWxzbyBzaG93bi4KCkNvZWZmaWNpZW50cyBhcmUgb2Z0ZW4gd2hhdCB5b3UgY2FyZSBhYm91dC4gVGhlIGVzdGVtYXRlIHRlbGxzIHVzIGFib3V0IHRoZSBzbG9wZSBhbmQgaW50ZXJjZXB0IG9mIHRoZSBsaW5lYXIgcmVncmVzc2lvbi4gVGhlc2UgdmFsdWVzIGJhc2ljYWxseSBzYXkgb3VyIG1vZGVsIGxvb2tzIGxpa2UgdGhpcwoKbWFzcyA9IC0zMi41ICsgMC42MiAqIGhlaWdodAoKV2UgZG9uJ3Qga25vdyB0aGUgdHJ1ZSB2YWx1ZXMgb2YgdGhlc2UgcGFyYW10ZXJzLCBzbyB0aGUgc3RhbmRhcmQgZXJyb3IgZ2l2ZXMgdXMgYW4gaWRlYSBvZiB0aGUgcmFuZ2VzIG9mIHRoZSB0d28uIFQtdmFsdWUgaXMgdGhlIHRlc3Qgc2NvcmUgdG8gc2VlIGhvdyBnb29kIHRob3NlIGFyZSwgYmFuZCB0aGUgcC12YWx1ZSB0ZWxscyB5b3UgaWYgdGhlIGFuc3dlciBpcyBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50LgoKNC4wMiB4IDEwXi0xMiA8IDAuMDAyIHNvIGl0IHRoZSBoZWlnaHQgdmFsdWUgZ2V0cyBhIGJ1bmNoIG9mIHN0YXJzIGFmdGVyIGl0LiBJIHVzdWFsbHkgZG9uJ3QgbWFrZSB0b28gbXVjaCBvZiB0aGUgcCB2YWx1ZSBvZiB0aGUgaW50ZXJjZXB0LgoKUmVzaWR1YWwgc3RhbmRhcmQgZXJyb3IgaXMgdGhlIHN0YW5kYXJkIGRldmlhdGlvbiBvZiB0aGUgcmVzaWR1YWxzLCBhY2NvcmRpbmcgdG8gdGhlIGludGVybmV0Lgo1NiBkZWdyZWVzIG9mIGZyZWVkb20gaXMgY2FsY3VsYXRlZCBhcyBvdXIgc2FtcGxlIHNpemUsIG1pbnVzIHRoZSBjb21wbGV4aXR5IG9mIHRoZSBtb2RlbC4gIFdlIGhhdmUgNTggY2hhcmFjdGVycywgYnV0IHdlIGxvb3NlIG9uZSBERiBmb3IgdGhlIGludGVyY2VwdCBhbmQgYW5vdGhlciBmb3IgdGhlIGhlaWdodCB2YXJhaWJsZSB0aGF0IHdlIGFyZSB1c2luZy4KClRoZXJlIGlzIGFsc28gYW4gUl4yLCBhbmQgYWRqdXN0ZWQgUl4yIHdoaWNoIGdldHMgc21hbGxlciBhcyB0aGUgbW9kZWwgZ2V0cyBtb3JlIGNvbXBsaWNhdGVkLCBhbmQgYSBwLXZhbHVlIGZvciB0aGUgd2hvbGUgbW9kZWwuCgojIyBSZXNpZHVhbHMKTGluZWFyIG1vZGVscyBsaWtlIHRvIGFzc3VtZSB0aGF0IHRoZSByZXNpZHVhbHMgYXJlIG5vcm1hbGx5IGRpc3RyaWJ1dGVkLiBXZSB3YW50IHRvIG1ha2Ugc3VyZSB0aGF0IG5vIHBlcnNvbiBpcyByZWFsbHkgYWZmZWN0aW5nIG91ciBtb2RlbCB0b28gbXVjaC4gV2UgY2FuIHBsb3QgdGhlIG1vZGVsIHRvIGRvIHRoaXMuCgpgYGB7cn0KcGxvdChtb2QpCmBgYAoKIyMgUHJvY2Vzc2luZyBtb2RlbHMKCnRoZSBgYnJvb21gIHBhY2thZ2UgZ2l2ZXMgYSBuaWNlIG1hdHJpeCB2ZXJzaW9uIG9mIG1vZGVsIHJlc3VsdHMKCmBgYHtyfQpsaWJyYXJ5KGJyb29tKQp0aWR5KG1vZCkKYGBgCgpMZXRzIHNlZSBob3cgd2VsbCBvdXIgbW9kZWwncyBwcmVkaWN0aW9ucyBjb21wYXJlIHRvIHRoZSBhY3R1YWwgZGF0YS4KCldlIGNhbiB1c2UgdGhlIHByZWRpY3QgZnVuY3Rpb24gdG8gZ2VuZXJhdGUgc29tZSBwcmVkaWN0aW9ucwoKYGBge3J9CiMgTWFrZSBhIGRhdGEgZnJhbWUgY29udGFpbmluZyBhbGwgb2YgdGhlIHBvc3NpYmxlIGhlaWdodHMsIGZyb20gdGhlIHNob3J0aXN0IHRvIHRhbGxlc3QgY2hhcmFjdGVyCnByZWRQcmVEZiA8LSB0aWJibGUoCiAgaGVpZ2h0ID0gbWluKG5hLm9taXQoc3RhcndhcnMwMSRoZWlnaHQpKTogbWF4KG5hLm9taXQoc3RhcndhcnMwMSRoZWlnaHQpKQopCgojIGZvciBlYWNoIGhlaWdodCwgcHJlZGljdCB0aGUgbWFzcwpQcmVkTWFzcyA8LSBwcmVkaWN0KG1vZCwgcHJlZFByZURmKSAjIHByZWRpY3QgcmVxdWlyZXMgYSBtb2RlbCwgbW9kLCBhbmQgYSBkYXRhIGZyYW1lIHdpdGggdGhlIHByZWRpY3RvcnMgaW4gaXQuIE91ciBvbmx5IHByZWRpY3RvciBpcyBoZWlnaHQsIHNvIGl0cyBqdXN0IGEgZGF0YSBmcmFtZSB3aXRoIG9uZSB0aGluZwoKIyBTdGljayB0aGUgcmFuZ2Ugb2YgaGVpZ2h0cyBhbmQgcHJlZGljdGVkIG1hc3NlcyB0b2dldGhlciBpbnRvIGEgZGF0YSBmcmFlbWUKcHJlZERmIDwtIHRpYmJsZShoZWlnaHQgPSBwcmVkUHJlRGYkaGVpZ2h0LCBtYXNzID0gUHJlZE1hc3MpCgojIHBsb3QgdGhlIG9yaWdpbmFsIGRhdGEKc3RhcndhcnMwMSAlPiUgZ2dwbG90KGFlcyh4ID0gaGVpZ2h0LCB5ID0gbWFzcykpICsgZ2VvbV9wb2ludCgpICsKICAjIHBsb3QgdGhlIHByZWRpY3RlZCB2YWx1ZXMsIG5vdGljZSB0aGF0IEkgaW5jbHVkZSB0aGUgcHJlZGljdGVkIGRhdGEgaW4gdGhlICJkYXRhIiBhcmd1bWVudCBiZWxvdwogIGdlb21fcGF0aChhZXMoeCA9IGhlaWdodCwgeSA9IG1hc3MpLCBkYXRhID0gcHJlZERmLCBjb2xvciA9ICJkYXJrZ3JlZW4iKQpgYGAKCgojIE1vZGVscyB3aXRoIGNhdGVnb3JpY2FsIHZhcmlhYmxlcwpUaGVyZSBhcmUgYSBsb3Qgb2Ygc3BlY2llcyByaWdodCBub3csIGJ1dCBtb3N0IG9mIHRoZW0gb25seSBoYXZlIGEgZmV3IGNoYXJhY3RlcnMuIEknbSBpbnRlcmVzdGVkIGluIGxvb2tpbmcgYXQgdGhpbmdzIHRoYXQgZGlmZmVyZW50aWF0ZSBodW1hbnMgZnJvbSBvdGhlciBzcGVjaWVzLiBTbyBsZXRzIG1ha2UgYSBuZXcgY29sdW1uIHRoYXQgaW5kaWNhdGVzIHdoZXRoZXIgYSBjaGFyYWN0ZXIgaXMgaHVtYW4KCmBgYHtyfQpzdGFyd2FyczAyIDwtIHN0YXJ3YXJzMDEgJT4lIG11dGF0ZShpc0h1bWFuID0gaWZlbHNlKHNwZWNpZXMgPT0gIkh1bWFuIiwgIlllcyIsICJObyIpKQpgYGAKCkxldHMgc2VlIGlmIGh1bWFuaXR5IGlzIGEgcmVhc29uYWJsZSBwcmVkaWN0b3Igb2YgYSBjaGFyYWN0ZXJzJyBtYXNzLgoKRmlyc3QsIGxldHMgcGxvdCB0aGUgdHdvIGFnYWluc3QgZWFjaG90aGVyCgpgYGB7cn0KZ2dwbG90KGFlcyhtYXNzLCBpc0h1bWFuKSwgZGF0YSA9IHN0YXJ3YXJzMDIpICsgZ2VvbV9wb2ludCgpCmBgYAoKb2ssIG9uZSBwZXJzb24gaGFzIGEgc3BlY2llcyB0aGF0IGlzIE5BLiBJdCBsb29rcyBsaWtlIGh1bWFucyB0ZW5kIHRvIGJlIGludGVybWVkaWF0ZSBpbiBtYXNzLCB3aXRoIGEgbG90IG9mIG92ZXJsYXAgb2YgdGhlIG5vbiBodW1hbnMuCgpMZXRzIGFzayBpZiBodW1hbnMgdGVuZCB0byBoYXZlIGRpZmZlcmVudCBtYXNzIHRoYW4gbm9uIGh1bWFucy4gSSdtIGJldHRpbmcgbm90IHNvIG11Y2gsIHNpbmNlIHRoZXkgc2VlbSB0byBiZSByaWdodCBpbiB0aGUgbWlkZGxlIG9mIHRoZSBvdGhlciBvcmdhbmlzbXMgbWFzc2VzLgoKYGBge3J9Cm1vZE1IIDwtIGxtKG1hc3MgfiBpc0h1bWFuLCBkYXRhID0gc3RhcndhcnMwMikKc3VtbWFyeShtb2RNSCkKYGBgCgpTbyB3aXRoIGNhdGVnb3JpY2FsIHZhcmlhYmxlcywgd2UgY2FuIGludGVycGVyZXQgdGhpcyBtdWNoIHRoZSBzYW1lIHdheSBhcyBpbiB0aGUgbGFzdCBwbG90LiBXZSBoYXZlIGEgbW9kZWwgdGhhdCBsb29rcyBzb21ldGhpbmcgbGlrZS4KCm1hc3MgPSA3MiArIDExICogaXNIdW1hblllcwoKVGhpcyBlc3NlbnRpYWxseSBzYXlzIHRoYXQgaXQgdGhlIGNoYXJhY3RlciB3YXMgbm90IGh1bWFuLCB3ZSB0cmVhdCBpc0h1bWFuWWVzIGFzIDAsIGFuZCBpZiB0aGUgY2hhcmFjdGVyIGlzIGh1bWFuLCB3ZSB0cmVhdCBpdCBhcyBvbmUuIFRoaXMgc2F5cyBlc3NlbnRpYWxseSB0aGF0IHRoZSBhdmVyYWdlIG1hc3Mgb2YgYSBodW1hbiBpcy4KCjcyICsgMTEgKiAxID0gODMKCkFuZCBmb3Igbm9uIGh1bWFucyAKNzEgKyAxMSAqIDAgPSA3Mi4KClRoYXQgc2FpZCwgb3VyIHAgdmFsdWUgZm9yIHRoZSBpc0h1bWFuWWVzIHRlcm0gaXMgMC4xNzEsIHdoaWNoIGlzID4gMC4wNSwgd2hpY2ggbWVhbnMgdGhhdCBldmVuIGlmIHRoZXJlIHdhcyBubyByZWFsIHRyZW5kLCBpdHMgcHJldHR5IGxpa2VseSB0aGF0IHdlIGNvdWxkIGhhdmUgZ290dGVuIGF0IGxlYXN0IHRoaXMgc3Ryb25nIG9mIGEgcmVzdWx0LgoKV2UgY2FuIG1ha2Ugb3VyIG1vZGVsIGV2ZW4gbW9yZSBjb21wbGljYXRlZCBieSBhZGRpbmcgaW4gZ2VuZGVyLgoKYGBge3J9CnBsb3RIdW1hblNwZWMgPC0gZ2dwbG90KGFlcyhtYXNzLCBpc0h1bWFuLCBzaGFwZSA9IGdlbmRlciwgbmFtZSA9IG5hbWUsIHNwZWNpZXMgPSBzcGVjaWVzKSwgZGF0YSA9IHN0YXJ3YXJzMDIpICsgZ2VvbV9wb2ludChzaXplID0gMikgCgpnZ3Bsb3RseShwbG90SHVtYW5TcGVjKQpgYGAKCkFtb25nIG90aGVyIHRoaW5ncywgaXQgYmVjb21lcyBjbGVhciB0aGF0IG1vc3QgY2hhcmFjdGVycyBpbiBzdGFyd2FycyBhcmUgbWFsZXMuCgpgYGB7cn0Kc3RhcndhcnMwMiAlPiUgZ3JvdXBfYnkoaXNIdW1hbiwgZ2VuZGVyKSAlPiUgc3VtbWFyaXplKG4gPSBuKCkpCmBgYAoKCk9uZSBjaGFyYWN0ZXIgaGFzIG5vIGdlbmRlciBhbmQgYSBmZXcgaGF2ZSBOQSBmb3IgZ2VuZGVyLiBBbmQgaW4gdGhlIHN0YXIgd2FycyB1bml2ZXJzZSwgdGhhdCBpcyB0aGUgbGltaXQgdG8gY2hhcmFjdGVycyBnZW5kZXIgdHlwZXMuIFdlIHdvbid0IGhhdmUgdGhlIHN0YXRpc3RpY2FsIHBvd2VyIHRvIGxvb2sgYXQgbW9yZSB0aGFuIG1hbGUgYW5kIGZlbWFsZSBjaGFyYWN0ZXJzIGhlcmUsIGFuZCBzbyBJJ20gZ29pbmcgdG8gbGltaXQgdGhlIGFuYWx5c2lzIGp1c3QgdG8ganVzdCBtYWxlLCBmZW1hbGUsIGh1bWFuLCBhbmQgbm9uaHVtYW4uCgpgYGB7cn0Kc3RhcndhcnMwMyA8LSBzdGFyd2FyczAyICU+JSBmaWx0ZXIoZ2VuZGVyICVpbiUgYygibWFsZSIsICJmZW1hbGUiKSwgaXNIdW1hbiAlaW4lIGMoIlllcyIsICJObyIpKQpgYGAKCmBgYHtyfQptb2RNSEcgPC0gbG0obWFzcyB+IGlzSHVtYW4gKyBnZW5kZXIsIGRhdGEgPSBzdGFyd2FyczAzKQpzdW1tYXJ5KG1vZE1IRykKYGBgCgpTbyBoZXJlIHdlIHRyeSBhIG1vZGVsIHdpdGggYm90aCBpc0h1bWFuIGFuZCBtYWxlLiBZb3Ugd291bGQgaW50ZXJwcmV0IHRoaXMgdGhlIHNhbWUgd2F5LiBTbyBhIGh1bWFuIGZlbWFsZSB3b3VsZCBoYXZlIGEgcHJlZGljdGVkIG1hc3Mgb2YuCgptYXNzID0gNTIgKyAoOSAqIDEpICsgKDI1ICogMCkKCk91ciBwIHZhbHVlIGlzIGFib3ZlIDAuMDUgZm9yIGlzSHVtYW5ZZXMgYWdhaW4gdGhvdWdoLCBzbyB0aGF0IHZhcmlhYmxlIGRvZXNuJ3Qgc2VlbSB0byBiZSBhIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQgcHJlZGljdG9yLgoKCgojIEludGVyYWN0aW9uIHRlcm1zCkxldHMgYWRkIGFuIGludGVyYWN0aW9uIHRlcm0KCmBgYHtyfQptb2RNSEcyIDwtIGxtKG1hc3MgfiBnZW5kZXIgKiBoZWlnaHQgLCBkYXRhID0gc3RhcndhcnMwMykKc3VtbWFyeShtb2RNSEcyKQpgYGAKClNvIGhlcmUsIHdlIHByZWRpY3Qgd2l0aCBhIGNvbnRpbnVvdXMgdmFyaWFibGUgKGhlaWdodCkgYSBkaXNjcmV0ZSB2YXJpYWJsZSAoZ2VuZGVyID0gbWFsZSwgMSBpZiB5ZXMsIDAgaWYgbm8pIGFuZCB0aGUgaW50ZXJhY3Rpb24gYmV0d2VlbiB0aCB0d28uIEluIGFueSBjYXNlIHRoaXMgaXNuJ3QgYSB1c2VmdWwgbW9kZWwsIGJhc2VkIG9uIHRoZSBwIHZhbHVlIGZvciBlYWNoIG9mIHRoZSB0ZXJtcy4gVGhhdCBzYWlkLCB0aGUgbW9kZWwgd2lkZSBwLXZhbHVlIDEuNjFlLTExIGlzIHJlYWxseSBsb3cuIEknbSBub3QgcXVpdGUgc3VyZSBob3QgdG8gaW50ZXJwZXJldCB0aGF0LiBUaGUgbW9kZWwgYXMgYSB3aG9sZSB3b3JrcywgYnV0IG5vIHNwZWNpZmljIHZhcmlhYmxlIGlzIGEgZ29vZCBwcmVkaWN0b3I/CgojIExvZ2lzdGljIG1vZGVscwpXaGF0IGlmIHdlIGhhdmUgYSBiaW5hcnkgdmFyaWFibGUgYXMgb3VyIHkgdmFsdWUsIHJhdGhlciB0aGFuIGFzIG91ciB4IHZhbHVlLiBUaGVuIHdlIHdhbnQgdG8gdXNlIGxvZ2lzdGljIHJlZ3Jlc3Npb24uCgpgYGB7cn0Kc3RhcndhcnMwNCA8LSBzdGFyd2FyczAzICU+JSBtdXRhdGUoaXNIdW1hbk51bSA9IGlmZWxzZShpc0h1bWFuID09ICJZZXMiLCAxLCAwKSkKYGBgCgoKCmBgYHtyfQptb2RCaW5vbSA8LSBnbG0oaXNIdW1hbk51bSB+IG1hc3MsIGZhbWlseSA9IGJpbm9taWFsLCBkYXRhID0gc3RhcndhcnMwNCkKc3VtbWFyeShtb2RCaW5vbSkKYGBgCgpTbyBpbiB0aGUgYWJvdmUgZXhhbXBsZSwgd2UgYXJlIHByZWRpY3RpbmcgdGhlIHByb2JhYmlsaXR5IG9mIGJlaW5nIG1hbGUgZnJvbSB0aGUgZGF0YS4KSXRzIG5vdCBhIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQgbW9kZWwsIGJ1dCBsZXRzIHBsb3QgdGhlIHByb2JhYmlsaXR5IG9mIGJlaW5nIGh1bWFuIGZyb20gbWFzcwoKYGBge3J9Cm1hc3NSYW5nZSA8LSBtaW4obmEub21pdChzdGFyd2FyczA0JG1hc3MpKTptYXgobmEub21pdChzdGFyd2FyczA0JG1hc3MpKQoKaHVtYW5QcmVkIDwtIHByZWRpY3QobW9kQmlub20sIG5ld2RhdGEgPSB0aWJibGUobWFzcyA9IG1hc3NSYW5nZSksIHR5cGUgPSAicmVzcG9uc2UiKSAjIGZvciBnbG0gaXRzIGNhbGxlZCBuZXdkYXRhLCBub3QgZGF0YQoKcHJlZERmTUcgPC0gdGliYmxlKG1hc3MgPSBtYXNzUmFuZ2UsIGlzSHVtYW5OdW0gPSBodW1hblByZWQpCnByZWREZk1HCgpnZ3Bsb3QoYWVzKHggPSBtYXNzLCB5ID0gaXNIdW1hbk51bSksIGRhdGEgPSBzdGFyd2FyczA0KSArIGdlb21fcG9pbnQoKSArIAogIGdlb21fcGF0aChkYXRhID0gcHJlZERmTUcpCmBgYAoKU28gaGVyZSwgdGhlIGxpbmUgaW5kaWNhdGVzIHRoZSBwcm9iYWJpbGl0eSwgYmFzZWQgb24gb3VyIG1vZGVsLCB0aGF0IGEgY2hhcmFjdGVyIGlzIGh1bWFuLCBiYXNlZCBvbiB0aGVpciBtYXNzLgoKSSBub3RpY2UgdGhvdWdoIHRoYXQgaHVtYW5zIHRlbmQgdG8gaGF2ZSBpbnRlcm1lZGlhdGUgbWFzcy4gTGV0cyB1c2UgYSBwb2x5bm9taWFsIHJlZ3Jlc3Npb24gdG8gYWRkcmVzcyB0aGlzLiBUbyBkbyB0aGlzLCBJIGluY2x1ZGUgYSBzcXVhcmVkIHRlcm0gaW4gdGhlIG1vZGVsLgoKYGBge3J9Cm1vZEJpbm9tMiA8LSBnbG0oaXNIdW1hbk51bSB+IG1hc3MgKyBJKG1hc3NeMiksIGZhbWlseSA9IGJpbm9taWFsLCBkYXRhID0gc3RhcndhcnMwNCkKc3VtbWFyeShtb2RCaW5vbTIpCmBgYApIZXksIFRoaXMgbG9va3Mgb2shCgpMZXRzIHBsb3QgaXQhCgpgYGB7cn0KbWFzc1JhbmdlIDwtIG1pbihuYS5vbWl0KHN0YXJ3YXJzMDQkbWFzcykpOm1heChuYS5vbWl0KHN0YXJ3YXJzMDQkbWFzcykpCgpodW1hblByZWQgPC0gcHJlZGljdChtb2RCaW5vbTIsIG5ld2RhdGEgPSB0aWJibGUobWFzcyA9IG1hc3NSYW5nZSksIHR5cGUgPSAicmVzcG9uc2UiKSAjIGZvciBnbG0gaXRzIGNhbGxlZCBuZXdkYXRhLCBub3QgZGF0YQoKcHJlZERmTUcgPC0gdGliYmxlKG1hc3MgPSBtYXNzUmFuZ2UsIGlzSHVtYW5OdW0gPSBodW1hblByZWQpCnByZWREZk1HCgpnZ3Bsb3QoYWVzKHggPSBtYXNzLCB5ID0gaXNIdW1hbk51bSksIGRhdGEgPSBzdGFyd2FyczA0KSArIGdlb21fcG9pbnQoKSArIAogIGdlb21fcGF0aChkYXRhID0gcHJlZERmTUcpCmBgYAoKVGhpcyBhY3R1YWxseSBtYWtlcyBvayBzZW5zZS4gQXQgaW50ZXJtZWRpYXRlIG1hc3NlcywgdGhpbmdzIGFyZSBhcm91bmQgNTAlIGxpa2VseSB0byBiZSBodW1hbi4gQXQgbGFyZ2UgYW5kIHNtYWxsIG1hc3NlcywgdGhleSBhcmUgYSBsb3QgbGVzcyBsaWtlbHkgdG8gYmUgaHVtYW4uCgo=